//////////////////////////////////////////////////////////////////////

// $Id: chibi-simple-fcgi.c 484 2014-05-01 00:58:30Z alan.watson.f $

//////////////////////////////////////////////////////////////////////

#define _POSIX_C_SOURCE 200809L
#define _SVID_SOURCE 1

#include <signal.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <time.h>

#include <unistd.h>
#include <syslog.h>
extern char **environ;

#include <fcgiapp.h>

//////////////////////////////////////////////////////////////////////

static void error(const char *, ...);
static void info(const char *, ...);

//////////////////////////////////////////////////////////////////////

// Formatting.

// The mprintf and vmprintf functions are portable versions of the GNU C
// library asprintf and vasprintf functions. They are version of the
// sprintf family that create a formatted string in allocated memory.

static char *
vmprintf(const char *format, va_list ap)
{
  va_list aq;
  va_copy(aq, ap);
  int n = vsnprintf(NULL, 0, format, ap);
  char *s = malloc(n + 1);
  if (s == NULL)
    error("malloc failed in vmprintf.");
  vsprintf(s, format, aq);
  return s;  
}

static char *
mprintf(const char *format, ...)
{
  va_list ap;
  va_start(ap, format);
  char *s = vmprintf(format, ap);
  va_end(ap);
  return s;  
}

//////////////////////////////////////////////////////////////////////

// Logging.

// If the environment variable CHIBI_SIMPLE_FCGI_LOG_FILE is set, use it
// for log messages, otherwise use syslog. If the environment variable
// CHIBI_SIMPLE_FCGI_LOG_IDENT is set, log messages will include its
// value, otherwise they will include "chibi-simple-fcgi".

// The error and info functions take sprintf-like arguments and use them
// to construct a log message. This log message is then either written
// to the log file or to syslog. The info function returns, but the
// error function calls exit.

static const char *logfile = NULL;
static const char *logident = NULL;
static FILE *logfp = NULL;

static void
log_start(void)
{
  logident = getenv("CHIBI_SIMPLE_FCGI_LOG_IDENT");
  if (logident == NULL)
    logident = "chibi-simple-fcgi";

  logfile = getenv("CHIBI_SIMPLE_FCGI_LOG_FILE");
  if (logfile == NULL)
    openlog(logident, LOG_CONS|LOG_PID, LOG_USER);
  else
    logfp = fopen(logfile, "a");
}

static void
error(const char *format, ...)
{
  va_list ap;
  va_start(ap, format);
  char *s = vmprintf(format, ap);
  va_end(ap);
  if (logfile == NULL) {
    syslog(LOG_ERR, "%s", s);
  } else if (logfp != NULL) {
    time_t t = time(NULL);
    struct tm *tm = localtime(&t);
    char timestamp[] = "YYYY-MM-DD HH:MM:SS";
    strftime(timestamp, sizeof(timestamp), "%Y-%m-%d %H:%M:%S", tm);
    fprintf(logfp, "%s: (%s) error: %s\n", timestamp, logident, s);
    fflush(logfp); 
  }
  free(s);
  exit(1);
}

static void
info(const char *format, ...)
{
  va_list ap;
  va_start(ap, format);
  char *s = vmprintf(format, ap);
  va_end(ap);
  if (logfile == NULL) {
    syslog(LOG_INFO, "%s", s);
  } else if (logfp != NULL) {
    time_t t = time(NULL);
    struct tm *tm = localtime(&t);
    char timestamp[] = "YYYY-MM-DD HH:MM:SS";
    strftime(timestamp, sizeof(timestamp), "%Y-%m-%d %H:%M:%S", tm);
    fprintf(logfp, "%s: (%s) %s\n", timestamp, logident, s);
    fflush(logfp); 
  }
  free(s);
}

//////////////////////////////////////////////////////////////////////

// Given our use of global variables (the environment, stdout, and
// stderr), there is little point in using the more complex FCGX
// interfaces for multi-threaded programs.

static FCGX_Stream *fcgxin;
static FCGX_Stream *fcgxout;
static FCGX_Stream *fcgxerr;
static FCGX_ParamArray fcgxenviron;

void
fcgx_start()
{
  signal(SIGPIPE, SIG_IGN);
  signal(SIGTERM, SIG_DFL);
  signal(SIGUSR1, SIG_IGN); // For Apache
}

int
fcgx_next(void)
{
  // Wait for the next request.
  int i = FCGX_Accept(&fcgxin, &fcgxout, &fcgxerr, &fcgxenviron);
  if (i != 0)
    error("FCGX_Accept returned %d.", i);
  return 1;
}

static void
fcgx_copy_from_server(FCGX_Stream *in, size_t *np, char **bp)
{
  // Copy the contents of the FCGX stream in into an allocated memory
  // buffer. Write the number of characters copied to np and the pointer
  // to the buffer to bp.
  const size_t q = 1024;
  char *b = NULL;
  size_t n = 0;
  size_t m = 0;
  for (;;) {
    if (n == m) {
      m += q;
      b = realloc(b, m);
      if (b == NULL)
        error("realloc() failed in fcgx_copy_from_server().");
    }
    int i = FCGX_GetStr(b + n, (int) (m - n), in);
    if (i == 0)
      break;
    n += i;
  }
  *np = n;
  *bp = b;
}


static void
fcgx_copy_to_server(size_t n, char *b, FCGX_Stream *out)
{
  // Copy the contents of the memory buffer b of length n to the FCGX
  // steam out.
  const size_t q = 1024;
  while (n > 0) {
    int i = FCGX_PutStr(b, (int) ((n < q) ? n : q), out);
    if (i < 0)
      error("FCGX_PutStr() failed in fcgx_copy_to_server().");
    b += i;
    n -= i;
  }
}

//////////////////////////////////////////////////////////////////////

// Prior to running the application code, we ...

// After running the application code, we ...
// 
// If the stderr temporary file is empty, we copy the contents of the
// stdout temporary file to the FastCGI stdout pseudo-stream.
// 
// If the stderr temporary file is not empty, the behaviour depends on
// the value of the SCHEME_SIMPLE_FCGI_STDERR_MODE environment variable.
// 
// If SCHEME_SIMPLE_FCGI_STDERR_MODE is unset or is "return-stderr-to-server",
// we copy the contents of the stdout and stderr temporary files to the
// corresponding FastCGI pseudo-streams, following the FastCGI
// specification. However, since the FastCGI specification does not
// specify what the server should do with the stderr pseudo-stream,
// different servers react differently to this. Therefore, we offer
// other options.
// 
// If SCHEME_SIMPLE_FCGI_STDERR_MODE is set to "return-stderr-in-500", we
// discard the contents of stdout and return (over the stdout
// pseudo-stream) a 500-status response and a HTML page containing the
// contents of stderr. We assume the contents of stderr are encoded as
// UTF-8.
// 
// If SCHEME_SIMPLE_FCGI_STDERR_MODE is set to "return-generic-500", we discard
// the contents of stdout and return (over the stdout pseudo-stream) a
// 500-status response and a generic HTML page that does not contain the
// contents of stderr.
// 
// If SCHEME_SIMPLE_FCGI_STDERR_MODE is set to "ignore", we discard the
// contents of stderr and copy the contents of stdout to the stdout
// pseudo-stream.
// 
// If SCHEME_SIMPLE_FCGI_STDERR_MODE is set to "terminate-process", we discard
// the contents of stderr, return (over the stdout pseudo-stream) a
// 500-status response and a generic HTML page that does not contain the
// contents of stderr, and exit.
// 
// These options are modelled on Microsoft IIS (see
// http://tinyurl.com/odo6wnm). However, the equivalent of "ignore" is
// called "IgnoreAndReturn200" in IIS. I've changed the name since if
// stdout contains an explicit Status line, it need not return an
// 200-status response.
//
// Application code that needs to handle exceptional cases differently
// can do so by voiding writing to stderr and instead writing an
// appropriate response, perhaps with an explicit Status line, to
// stdout.

static const char *stderrmode;

void
io_start(void)
{
  // Determine and validate the stderr mode.
  stderrmode = getenv("SCHEME_SIMPLE_FCGI_STDERR_MODE");
  if (stderrmode == NULL)
    stderrmode = "return-stderr-to-server";
  if (strcmp(stderrmode, "return-stderr-to-server") != 0 &&
      strcmp(stderrmode, "return-stderr-in-500"   ) != 0 &&
      strcmp(stderrmode, "return-generic-500"     ) != 0 &&
      strcmp(stderrmode, "ignore"                 ) != 0 &&
      strcmp(stderrmode, "terminate-process"      ) != 0)
    error("SCHEME_SIMPLE_FCGI_STDERR_MODE is \"%s\".", stderrmode);
}

static void 
io_before(size_t *np, char **bp)
{
  // Copy the contents of the FastCGI stdin pseudo-stream to a memory buffer.
  fcgx_copy_from_server(fcgxin, np, bp);
}

static void
io_return_500(size_t n, char *b)
{
  // Write a 500-status response to the FastCGI stdout pseudo-stream. If
  // fp is not NULL, include its contents.
  FCGX_PutS(
    "Status: 500 Internal Error\r\n"
    "Content-Type: text/html; charset=utf-8\r\n"
    "\r\n"
    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"
    "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"
    "<head>\n"
    "<title>500 Internal Error</title>\n"
    "</head>\n"
    "<body>\n"
    "<h1>500 Internal Error</h1>\n", fcgxout);
  if (n != 0) {
    FCGX_PutS("<pre>", fcgxout);
    for (size_t i = 0; i < n; ++i) {
      char c = b[i];
      if (c == '&')
        FCGX_PutS("&amp;", fcgxout);
      else if (c == '<')
        FCGX_PutS("&lt;", fcgxout);
      else
        FCGX_PutChar(c, fcgxout);
    }
    FCGX_PutS("</pre>\n", fcgxout);
  }
  FCGX_PutS(
    "</body>\n"
    "</html>\n", fcgxout);
}

static void 
io_after(size_t nout, char *bout, size_t nerr, char *berr)
{
  // Dispose of the memory buffers produced by the application code.
  if (nerr == 0) {
    fcgx_copy_to_server(nout, bout, fcgxout);
  } else if (strcmp(stderrmode, "return-stderr-to-server") == 0) {
    fcgx_copy_to_server(nout, bout, fcgxout);
    fcgx_copy_to_server(nerr, berr, fcgxout);
  } else if (strcmp(stderrmode, "return-stderr-in-500") == 0) {
    io_return_500(nerr, berr);
  } else if (strcmp(stderrmode, "return-generic-500") == 0) {
    io_return_500(0, NULL);
  } else if (strcmp(stderrmode, "ignore") == 0) {
    fcgx_copy_to_server(nout, bout, fcgxout);
  } else if (strcmp(stderrmode, "terminate-process") == 0) {
    io_return_500(0, NULL);
    exit(1);
  }
}

//////////////////////////////////////////////////////////////////////

// We run the application code with an environment consisting of the
// original environment of the process augmented with the FastCGI
// pseudo-environment.

static char **originalenviron;

static void
env_start(void)
{
  // Copy the environment to originalenviron.
  size_t n = 0;
  while (environ[n] != NULL)
    ++n;
  originalenviron = malloc((n + 1) * sizeof(*originalenviron));
  if (originalenviron == NULL)
    error("malloc() failed in env_start().");
  for (size_t i = 0; i < n; ++i) {
    size_t m = strlen(environ[i]) + 1;
    originalenviron[i] = malloc(m);
    if (originalenviron[i] == NULL)
      error("malloc() failed in env_start().");
    memcpy(originalenviron[i], environ[i], m);
  }
  originalenviron[n] = NULL;
}

static void
env_before(void)
{
  // Create an environment that is the union of the original
  // environment and the FastCGI pseudo-environment, with the latter
  // taking precedence.
  clearenv();
  for (size_t i = 0; originalenviron[i] != NULL; ++i)
    putenv(originalenviron[i]);
  for (size_t i = 0; fcgxenviron[i] != NULL; ++i)
    putenv(fcgxenviron[i]);
}

//////////////////////////////////////////////////////////////////////

#include <chibi/eval.h>

static sexp ctx;

void
chibi_start(void)
{
  // Load the Scheme wrapper program.
  ctx = sexp_make_eval_context(NULL, NULL, NULL, 1e8, 1e9);
  sexp_load_standard_env(ctx, NULL, SEXP_SEVEN);
  sexp_load_standard_ports(ctx, NULL, NULL, stdout, stderr, 1);
  char *libraryname = getenv("SCHEME_SIMPLE_FCGI_LIBRARY_NAME");
  if (libraryname == NULL)
    error("SCHEME_SIMPLE_FCGI_LIBRARY_NAME is not set in the environment."); 
  char *s = mprintf(
    "(import (scheme base)\n"
    "        (scheme write)\n"
    "        (scheme process-context)\n"
    "        (only (%s) main))\n", libraryname);
  sexp_eval_string(ctx, s, -1, NULL);
  free(s);
  sexp_eval_string(ctx,
    #include "chibi-simple-fcgi-call-main.c"
    , -1, NULL);
}

static void
chibi_log_string(const char *message, sexp string)
{
  if (0) {
    size_t n = sexp_string_length(string);
    char s[n + 1];
    memcpy(s, sexp_string_data(string), n);
    s[n] = 0;
    info("%s: \"%s\"", message, s);
  }
}

static void
chibi_next(size_t nin, char *bin, size_t *nout, char **bout, size_t *nerr, char **berr)
{
  // Call the Scheme call-main procedure. The procedure takes a single
  // string as an argument; this is the contents of the FCGI standard
  // input. It returns a pair of strings. The car is the contents of the
  // application code's current output port and the cdr is the contents
  // of the application code's current error port. The call-main
  // procedure handles the conversion between strings and ports and
  // calls the application code's main procedure.
  
  sexp_gc_var4(input_string, args, call_main, result);
  sexp_gc_preserve4(ctx, input_string, args, call_main, result);
 
  input_string = sexp_c_string(ctx, bin, nin);
  chibi_log_string("input", input_string);

  args = sexp_cons(ctx, input_string, SEXP_NULL);
  call_main = sexp_env_ref(sexp_context_env(ctx), sexp_intern(ctx, "call-main", -1), SEXP_FALSE);
  if (!sexp_procedurep(call_main))
    error("chibi_next: call_main is not a procedure.");
  result = sexp_apply(ctx, call_main, args);

  if (!sexp_pairp(result))
    error("chibi_next: result is not a pair.");
  if (!sexp_stringp(sexp_car(result)))
    error("chibi_next: (car result) is not a string.\n");
  if (!sexp_stringp(sexp_cdr(result)))
    error("chibi_next: (cdr result) is not a string.\n");

  chibi_log_string("output", sexp_car(result));
  chibi_log_string("error", sexp_cdr(result));

  *nout = sexp_string_length(sexp_car(result));
  if (*nout == 0)
    *bout = NULL;
  else {
    *bout = malloc(*nout);
    if (*bout == NULL)
      error("malloc() failed in chibi_next().");
    memcpy(*bout, sexp_string_data(sexp_car(result)), *nout);
  }

  *nerr = sexp_string_length(sexp_cdr(result));
  if (*nerr == 0)
    *berr = NULL;
  else {
    *berr = malloc(*nerr);
    if (*berr == NULL)
      error("malloc() failed in chibi_next().");
    memcpy(*berr, sexp_string_data(sexp_cdr(result)), *nerr);
  }

  sexp_gc_release4(ctx);
}

//////////////////////////////////////////////////////////////////////

int 
main(int argc, char** argv) 
{
  log_start();

  info("starting.");
  fcgx_start();
  io_start();
  env_start();
  chibi_start();
  
  info("waiting.");
  while (fcgx_next()) {
    size_t nin, nout, nerr;
    char *bin, *bout, *berr;
    env_before();    
    io_before(&nin, &bin);
    chibi_next(nin, bin, &nout, &bout, &nerr, &berr);
    io_after(nout, bout, nerr, berr);
    free(bin);
    free(bout);
    free(berr);
    info("waiting.");
  }

  info("exiting.");  

  return 0;
}

//////////////////////////////////////////////////////////////////////
